{-# LANGUAGE DeriveDataTypeable #-}
module Types where

import Constants
import Random

import Numeric

import qualified Data.Map as Map
import Data.Map as Map
import Data.Binary
import Data.Generics

import Statistics.RandomVariate

import Control.DeepSeq
import Control.Monad

import Debug.Trace

-- Miscellaneous useful things

showf :: Double -> String
showf f  
      | isNaN f || isInfinite f = "NA" -- from prelude
      | otherwise = ((showFFloat (Just 4) f) "")


rotate :: [a] -> [a]
rotate [h] = [h]
rotate [] = []
rotate (h:hs) = hs ++ [h]


-- DATES

newtype Date = D (Int,Int)  -- years, months
    deriving (Show,Eq,Ord,Data,Typeable) -- timestepper

instance Binary Date where
	put (D (y,m)) = put y >> put m
	get = get >>= \a -> get >>= \b -> return (D (a,b))

instance NFData Date where
   rnf (D (y,m)) = m `seq` y `seq` ()

-- months in year 
datePart:: Date -> String
datePart d = (showf $ dateFloat d)
    where  showf f = ((showFFloat (Just 4) f) "")
incDate (D (i, 11)) = D ((i+1), 0) -- NOTE == miy - 1
incDate (D (i, m)) = D (i, (m+1))
decDate (D (i, 0)) = D ((i-1), miy)
decDate (D (y, m)) = D (y, (m-1))

minusDate (D (y1, m1)) (D (y2, m2)) 
    | m1 - m2 >= 0 = D ((y1 - y2),(m1 - m2))
    | otherwise = D ((y1 - y2 - 1),(m1 - m2 + miy))

sumDate (D (y1, m1)) (D (y2, m2)) 
    | m1 + m2 < miy = D ((y1 + y2), (m1 + m2))
    | otherwise = D ((y1 + y2 + 1), (m1 + m2 - miy))

dateFloat :: Date -> Double
dateFloat (D (y,m)) = (fromIntegral y) + (fromIntegral m)/(fromIntegral miy )

zeroDate = D (0,0)

monthPart (D (_,m)) = m


-- Cash

type Cash = Double


-- *** BONDS AND CONTRACTS ***

data Contract = Bond { start:: Date,
                       maturity:: Date,
                       rate:: Double,
                       principal:: Cash,
                       rdefault:: Double,
                       recovery:: Double } |
                DefaultedBond { recval:: Double, principal:: Double } |
                NullBond
                deriving (Eq,Data,Typeable)

zeroBond = Bond zeroDate zeroDate 0 0 0 0
zeroBondP :: BondProposal
zeroBondP = (zeroDate,zeroDate,0,0,0,0) 

-- A propose bond is constructed as a tuple for efficiency - the hope is to keep these things off the heap as much as possible
-- we are going to try to get these things as unboxed inputs to evaluateContract

type BondProposal = (Date,Date,Double,Cash,Double,Double)
data BondProposal2 = BP2 !Date !Date !Double !Cash !Double !Double
-- (start,maturity,rate,principal,rdefault,recovery)

instance Binary Types.Contract where
  put (Bond a b c d e f) = putWord8 0 >> put a >> put b >> put c >> put d >> put e >> put f
  put (DefaultedBond a b) = putWord8 1 >> put a >> put b
  put NullBond = putWord8 2
  get = do
    tag_ <- getWord8
    case tag_ of
      0 -> get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> get >>= \e -> get >>= \f -> return (Bond a b c d e f)
      1 -> get >>= \a -> get >>= \b -> return (DefaultedBond a b)
      2 -> return NullBond
      _ -> fail "no parse"

instance (Show Contract) where
  show (Bond { start = s,
            maturity = m,
            rate = r,
            principal = p,
            rdefault = rd,
            recovery = rec }) 
      = "   BOND : " ++ (show s) ++ " - " ++ (show m) ++ " prin: " ++ 
               ((showFFloat (Just 4) p) "")
               ++ " rate: " ++ ((showFFloat (Just 4) r) "") ++ " rdef: " ++
               ((showFFloat (Just 4) rd) "")
  show (DefaultedBond n o) = "   DEFA : now: " ++ ((showFFloat (Just 4) n) "") ++ " was: " ++ ((showFFloat (Just 4) o) "")

buildContract :: BondProposal  -> Contract
buildContract (start,maturity,rate,principal,rdefault,recovery) = 
      Bond { start=start,maturity=maturity,rate=rate,principal=principal,rdefault=rdefault,recovery=recovery }

invBuildContract :: Contract -> BondProposal  
invBuildContract  Bond { start=start,maturity=maturity,rate=rate,principal=principal,rdefault=rdefault,recovery=recovery }
     = (start,maturity,rate,principal,rdefault,recovery) 

instance (NFData Contract) where
   rnf (Bond a b c d e f) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d `seq` rnf e `seq` rnf f
   rnf (DefaultedBond a b) = rnf a `seq` rnf b
   rnf NullBond = ()

valueBond (Bond {principal=p}) = p 
valueBond (DefaultedBond {recval = v}) = v
valueBond NullBond = 0


--
-- Rates are set using rate start and rate step parameters.  We start by proposing the "Start" rate, then continue for
-- several "steps" - number of steps is in Constants.hs, code in newProposal in Simulator.hs
-- 
data ContractFactory 
    = BondCF { defaultDist::ProbabilityDistribution,
               principalDist::ProbabilityDistribution,
               rateStep::ProbabilityDistribution,
               rateStart::ProbabilityDistribution,
               durationDist::ProbabilityDistribution,
               recoveryDist::ProbabilityDistribution }
      deriving (Show,Data,Typeable)

instance Binary Types.ContractFactory where
  put (BondCF a b c d e f) = put a >> put b >> put c >> put d >> put e >> put f
  get = get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> get >>= \e -> get >>= \f -> return (BondCF a b c d e f)

instance (NFData ContractFactory) where
   rnf (BondCF a b c d e f) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d `seq` rnf e `seq` rnf f




